home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / tdk_v120.zip / TEST.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-15  |  10KB  |  212 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....}
  13.  
  14. {   Adjust your compiler directives as you see fit  }
  15. {$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
  16. {$M 65520,0,655360}
  17. Program TEST;
  18.  
  19. USES _EXIT, DOORKIT1, DOORKIT2, CRT; {The bare minimum of unit declarations..}
  20.                                      {Make note of the order of declarations.}
  21. VAR                                  {Note: CRT is not required in all doors.}
  22.   Str   : STRING;
  23.   Ch    : CHAR;
  24.   X     : BYTE;
  25.   Y     : BYTE;
  26.   MinX  : BYTE;
  27.   MinY  : BYTE;
  28.   MaxX  : BYTE;
  29.   MaxY  : BYTE;
  30.   Loop  : BYTE;
  31.   Quit  : BOOLEAN;
  32.  
  33. BEGIN
  34.   {--------------------------------------------------------------------------}
  35.   { This is all that is needed to initialize your door program...You may add }
  36.   { more variable/constant modifications at your own discretion...           }
  37.   {--------------------------------------------------------------------------}
  38.   ProgramName := 'TEST.EXE Version -9.02E+16';
  39.   ProgramDesc := 'Example Door Program For "The DoorKit"';
  40.   {--------------------------------------------------------------------------}
  41.   { After you have made all of your variable/constant modifications, you can }
  42.   { initialize or "Start Up" your door program...                            }
  43.   {--------------------------------------------------------------------------}
  44.   InitDoorKit;
  45.   {--------------------------------------------------------------------------}
  46.   REPEAT
  47.     sWriteln(''); InfoText('Please Select A Function:'); sWriteln('');
  48.     LineBar(1,0,33);
  49.     CPrompt('A',' Display An ANSI Screen File');  sWriteln('');
  50.     CPrompt('B',' Display A Text File');          sWriteln('');
  51.     CPrompt('C',' Test An Entry Field');          sWriteln('');
  52.     CPrompt('D',' Display A Window');             sWriteln('');
  53.     CPrompt('E',' Run An Entry Form Script');     sWriteln('');
  54.     CPrompt('F',' Simulate Drop Down Menus');     sWriteln('');
  55.     CPrompt('G',' Test Cursor Control Keys');     sWriteln('');
  56.     CPrompt('Q',' Quit/Exit The Demo Program');   sWriteln('');
  57.     LineBar(1,0,33);
  58.     FancyPrompt;
  59.     Ch := UPCASE(sReadKey); sWriteln('');
  60.     CASE Ch OF
  61.       'A' : BEGIN
  62.               ShowScreen('BBS-UTIL.ANS');
  63.               AnyKey;
  64.             END;
  65.       'B' : ShowTextFile('DOORKIT.DOC');
  66.       'C' : BEGIN
  67.               sWriteln('');
  68.               OutTxt(11,0,'Enter Some Text: ');
  69.               IF Graphics = TTY THEN Str := NormalInput(50,'')
  70.                                 ELSE Str := NormalPrompt(50,'');
  71.               Str := CvtVars(Str); {Check For Variables}
  72.               sWriteln('');
  73.               Set_Color(10,0);
  74.               CvtColors('You Entered: {14}'+Str,TRUE); {Converts Colors}
  75.               sWriteln('');
  76.               AnyKey;
  77.             END;
  78.       'D' : IF Graphics <> TTY Then BEGIN
  79.               sClrScr;
  80.               OutTxtL(10,0,'Since this procedure uses specific X / Y coordinates,  the caller must have');
  81.               OutTxtL(10,0,'ANSI graphics capabilities. TTY/ASCII callers would see nothing but garbage');
  82.               OutTxtL(10,0,'on their screen. This is the reason for the "IF Graphics <> TTY THEN BEGIN"');
  83.               DrawWin(5,5,74,19, 'This Is An Example Window');
  84.               OutTxtXY(7,7,11,1, '    Enter Your Name:'); DummyField(27,7,40,'');
  85.               OutTxtXY(7,8,11,1, ' Enter Your Address:'); DummyField(27,8,40,'');
  86.               OutTxtXY(7,9,11,1, '    Enter Your City:'); DummyField(27,9,20,'');
  87.               OutTxtXY(7,10,11,1,'   Enter Your State:'); DummyField(27,10,20,'');
  88.               OutTxtXY(7,11,11,1,'Enter Your Zip Code:'); DummyField(27,11,12,'');
  89.               OutTxtXY(7,12,11,1,' Voice Phone Number:'); DummyField(27,12,12,'');
  90.               OutTxtXY(7,13,11,1,'  Data Phone Number:'); DummyField(27,13,12,'');
  91.               SysButton(56,15,'S','ave');
  92.               SysButton(65,15,'Q','uit');
  93.               Str := SysField(27,7,2,40,'');
  94.               Str := SysField(27,8,2,40,'');
  95.               Str := SysField(27,9,2,20,'');
  96.               Str := SysField(27,10,2,20,'');
  97.               Str := SysField(27,11,1,12,'');
  98.               Str := SysField(27,12,1,12,'');
  99.               Str := SysField(27,13,1,12,'');
  100.               OutTxtXY(7,17,10,1,'Do you see how this mess of mine is actually working?');
  101.               sGotoXY(5,23); AnyKey;
  102.             END ELSE BEGIN
  103.               sWriteln('');
  104.               OutTxtL(12,0,'Sorry, ANSI Graphics Requires For This....');
  105.               sWriteln('');
  106.               AnyKey;
  107.             END;
  108.       'E' : RunEntryForm('QUEST1.FRM');
  109.       'F' : BEGIN
  110.               sClrScr; sGotoXY(1,1); Set_Color(0,7); sClrEol;
  111.               MenuBarItem(3,1,'M','ain Menu');
  112.               MenuBarItem(23,1,'F','ile Menu');
  113.               MenuBarItem(43,1,'E','-Mail Menu');
  114.               MenuBarItem(63,1,'S','ysOp Menu');
  115.               DrawMenu(2,2,20,10);
  116.               MenuItem(3,3,'F','irst Function');
  117.               MenuItem(3,4,'S','econd Function');
  118.               MenuItem(3,5,'T','hird Function');
  119.               MenuLine(2,6,19);
  120.               MenuItem(3,7,'A','nother Function');
  121.               MenuItem(3,8,'S','omthing Else');
  122.               MenuItem(3,9,'Q','uit This Menu');
  123.               OutTxtXY(2,13,10,0,'Since this door kit provides full support for local and remote cursor control');
  124.               OutTxtXY(2,14,10,0,'keys, you could create doors that have full drop down menus and windows that');
  125.               OutTxtXY(2,15,10,0,'can pop up whenever and wherever you need them. With this, you can provide');
  126.               OutTxtXY(2,16,10,0,'your users with a more "Natural" look and feel which will make it easier for');
  127.               OutTxtXY(2,17,10,0,'them to understand and use your doors. Using the cursor control keys to move');
  128.               OutTxtXY(2,18,10,0,'the cursor and menus around just seems to come naturally most people.');
  129.               sGotoXY(2,23); AnyKey;
  130.             END;
  131.       'G' : BEGIN
  132.               Set_Color(7,0); sClrScr;
  133.               OutTxtL(15,1,PadRight(' This is a test of the local and remote cursor control keys....',' ',79));
  134.               OutTxtL(11,1,PadRight(' Press ESC twice to exit. Use ^N and ^P to increment and decrement colors.',' ',79));
  135.               Set_Color(7,0); sClrEol;
  136.               Quit := FALSE;
  137.               MinX := 1; MaxX := 79; X := MinX;
  138.               MinY := 3; MaxY := LengthScr; Y := MinY;
  139.               REPEAT
  140.                 sGotoXY(X,Y);
  141.                 Ch := sReadKey;
  142.                 CASE Ch OF
  143.                   #0  : Str := s_ReadKey;
  144.                   #22 : BEGIN
  145.                           sWaitInput(250);
  146.                           IF sKeyPressed THEN Str := Ch + sReadKey ELSE Str := Ch;
  147.                         END;
  148.                   #27 : BEGIN
  149.                           Str := Ch;
  150.                           Ch  := sReadKey;
  151.                           IF Ch = #27 THEN BEGIN
  152.                             Quit := TRUE;
  153.                             STR  := '';
  154.                           END ELSE Str := Str + Ch + sReadKey;
  155.                         END;
  156.                   ^N  : BEGIN
  157.                           IF TextAttr AND $0f < 15 THEN INC(TextAttr) ELSE TextAttr := TextAttr AND $F0;
  158.                           IF NOT Local THEN SendStr(AnsiColor);
  159.                         END;
  160.                   ^P  : BEGIN
  161.                           IF TextAttr AND $0f > 0  THEN DEC(TextAttr) ELSE TextAttr := TextAttr AND $F0 OR $F;
  162.                           IF NOT Local THEN SendStr(AnsiColor);
  163.                         END;
  164.                   #8  : IF X > MinX THEN BEGIN
  165.                           DEC(X);
  166.                           sWrite(#8+BackSpaceChar+#8);
  167.                         END;
  168.                   #1..#31:; {Scrap keys, just ignore them....}
  169.                   ELSE BEGIN
  170.                     IF X < MaxX THEN BEGIN
  171.                       sWriteC(Ch);
  172.                       INC(X);
  173.                     END ELSE IF X = MaxX THEN sWriteC(Ch);
  174.                   END;
  175.                 END;
  176.                 IF Str <> '' THEN FOR Loop := TTY TO AVATAR DO BEGIN
  177.                   IF Str = CursorMove.Up[Loop] THEN BEGIN
  178.                     DEC(Y);
  179.                     Str := '';
  180.                   END;
  181.                   IF Str = CursorMove.Down[Loop] THEN BEGIN
  182.                     INC(Y);
  183.                     Str := '';
  184.                   END;
  185.                   IF Str = CursorMove.Left[Loop] THEN BEGIN
  186.                     DEC(X);
  187.                     Str := '';
  188.                   END;
  189.                   IF Str = CursorMove.Right[Loop] THEN BEGIN
  190.                     INC(X);
  191.                     Str := '';
  192.                   END;
  193.                   IF Str = CursorMove.Home[Loop] THEN BEGIN
  194.                     X   := MinX;
  195.                     Str := '';
  196.                   END;
  197.                   IF Str = CursorMove.EndKey[Loop] THEN BEGIN
  198.                     X   := MaxX;
  199.                     Str := '';
  200.                   END;
  201.                 END;
  202.                 IF X > MaxX THEN X := MaxX;
  203.                 IF Y > MaxY THEN Y := MaxY;
  204.                 IF X < MinX THEN X := MinX;
  205.                 IF Y < MinY THEN Y := MinY;
  206.               UNTIL Quit;
  207.             END;
  208.     END;
  209.     IF Ch <> 'Q' THEN ShowProgramAd;
  210.   UNTIL Ch = 'Q';
  211. END.
  212.